Introduction

Essendo una pandemia ancora in corso ed essendo implicati molti fattori, molti dei quali difficili da comprendere non avendo una conoscenza del dominio adatta, si proverà a rispondere a delle domande basandosi sui dati a disposizione.

Obiettivi

Per rispondere a tali domande, sono stati scaricati dei dati globali come sul numero di casi l’arco di tempo da analizzare. Da questo si può avere accesso ai dati per ogni stato. Riguardo i confronti tra stati d’Europa, oppure nello specifico per l’Italia, sono stati scaricati dei dataset su cui apportare delle trasformazioni, che verrano spiegate in seguito, per raggiungere gli obiettivi datisi.

Preprocessing del dataset globale

Sono state eseguite:

  • trasformazione data.
  • rimozione di colonne non utili all’analisi.
  • raggruppare stati.
  • dataset con contagi, guariti, morti.
global_df_date = global_df_init %>% 
  gather(X1.22.20:X6.22.20, key ="date", value = "cases") %>%  ## remember to update final date
  select( -Lat, -Long ) 

global_df_date$date = substring( global_df_date$date, 2)
names(global_df_date)[names(global_df_date)=="Country.Region"] <- "country"

global_df_date = global_df_date %>% 
  mutate( date = mdy(date) ) %>% 
  group_by( country, date ) %>%  ## avendo country duplicati
  summarise( 
    cases = sum( cases )
    ) %>%
  ungroup() # per utilizzare plotly
  

## mi serve dopo 
global_data = global_df_date %>% 
    group_by(  date ) %>%  ## focus sui casi al giorno 
    summarise(
      cases = sum( cases )
    ) 

# per il plot non consideriamo paesi con meno di 10_000 casi 
global_filter = global_df_date %>%
  filter( cases > 20000 )

global_filter_noUs_Brazil <- global_filter %>% 
        filter( country != "US" & country != "Brazil")

Visualizzazione dei dati globali

Si da una prima visualizzazione della curva dei contagi. Utilizzando ggplotly si ha la possibilita di avere un grafico interattivo, per analizzare meglio la curva e la differneza tra i vari stati

p <- ggplot( global_filter, aes( x = date, y = cases, group = country,)) + 
  geom_line( alpha = 0.3 ) + 
  geom_smooth( se = FALSE) +
  theme_minimal()  

fig <- ggplotly(p)
fig

Concentradosi sui casi di stati con un numero di positivi significativo, si può fare un primo confronto.

ggplot( global_filter, aes( x = date, y = cases ) ) + 
  geom_line( aes( group = country, color = country) , alpha = 1.2 ) + 
  facet_wrap( ~country ) +
  theme_minimal() + 
  theme(legend.position="none",
        axis.text.x = element_text(angle = 70, hjust = 1 ),
        axis.text.y = element_blank())

Togliendo Brazile e USA, si può visualizzare in miglior modo le curve di stati in cui il numero di contagi si è stabilizzato.

# ggplot( global_maj_noUS, aes( x = date, y = cases ) ) + 
#   geom_line( aes( group = country, color = country) , alpha = 1.2 ) + 
#   facet_wrap( ~country ) +
#   theme_minimal() + 
#   theme(legend.position="none",
#         axis.text.x = element_text(angle = 70, hjust = 1 ),
#         axis.text.y = element_blank()) 


ggplot( global_filter_noUs_Brazil, aes( x = date, y = cases) ) + 
  geom_line( aes(group = country, color = country ), alpha = 1.2 ) + 
  facet_wrap( ~country ) +
  theme_minimal() + 
  theme(legend.position="none",
        axis.text.x = element_text(angle = 70, hjust = 1 ),
        axis.text.y = element_blank())

Dati globali completi

## recovery
global_rec_forDate = global_rec_init %>% 
  gather(X1.22.20:X6.22.20, key ="date", value = "cases") %>% 
  select( -Province.State, -Lat, -Long )
remove( global_rec_init )

global_rec_forDate$date = substring( global_rec_forDate$date, 2)
names(global_rec_forDate)[names(global_rec_forDate)=="Country.Region"] <- "country"


global_rec = global_rec_forDate %>% 
  group_by(  date ) %>% 
  summarise( 
    tot_rec = sum( cases )
    ) %>%
   mutate( date = mdy( date ))

remove( global_rec_forDate )

## deaths 
global_death_forDate = global_death_init %>% 
  gather(X1.22.20:X6.22.20, key ="date", value = "cases") %>% 
  select( -Province.State, -Lat, -Long )
remove( global_death_init )

global_death_forDate$date = substring( global_death_forDate$date, 2)
names(global_death_forDate)[names(global_death_forDate)=="Country.Region"] <- "country"

global_death = global_death_forDate %>% 
  group_by( date ) %>% 
  summarise( 
    tot_deaths= sum( cases )
    ) %>%
   mutate( date = mdy( date ))
remove( global_death_forDate)

Si da uno sguardo generale constatare la curva esponenziale di contagi nel mondo. Per completezza si aggiungono le curve dei guariti e dei morti.

### join tra i dataset di contagi, guariti e morti 
global_ <- full_join( global_data, global_rec, )
global <- full_join( global_, global_death)

names(global)[names(global)=="cases"] <- "infects"
names(global)[names(global)=="tot_deaths"] <- "deaths"
names(global)[names(global)=="tot_rec"] <- "recovered"

### trovare il modo per usare group type { cases, tot_rec, tot_death }
global <- gather(global, key = "type", value = "n_cases",
       infects, recovered, deaths)

ggplot( global, aes( x = date, y = n_cases, roup = type, color = type ) ) + 
  geom_line( ) + 
  geom_point( size = 0.1) + 
  theme_minimal() + 
  ylab( "cases" )

Confronto tra continenti

Utilizzando un dataSet contenente i nomi degli stati per continente per inserirli nel dataset dell’analisi, prima di raggrupparli continente occorre:

  • verificare se ci sono Stati mancanti
  • verificare la coerenza dei nomi tra i due dataset
  • eseguire un join fra i dataset
t_continent <- continent_df %>% 
  group_by( Continent_Name ) %>% 
  summarise(
    cases = sum( cases ) 
  )


sum <- sum( t_continent[4,"cases"], t_continent[6,"cases"]  )
t_continent = t_continent %>% add_row( Continent_Name = "America", cases = sum )

t_continent %>% 
  arrange( -cases )

America e Europa hanno il maggior numero di casi positivi. L’Asia pur avendo una densità quasi il doppio rispetto l’america ha la metà dei contagi. In Oceania c’è un numero relativamente basso di contagi, ma rispetto alla popolazione?

Vediamo le informazioni riguardanti la popolazione, per poi calcolare l’indice di prevalenza:
Prevalenza: è il rapporto gra il numero di eventi sanitari rilevati in un certo momento e il numero della popolazione

Calcolandoli per continente si hanno dei dati molto generali, tenendo conto che ci sono stati paesi molto colpiti e paesi con contagi tendenti allo zero.

## data from wikipedia 

continenti <- c("Asia", "America", "Africa", "Europe", "Oceania")
area <- c( 43810000, 42330000, 30370000, 10400000, 9010000)
popolazione <- c( 4463000000, 1001000000, 1200000000, 741000000, 40000000 )
densita <- c( 100, 22, 36, 73, 5 )

info_continents <- data.frame(Continent_Name=continenti, area=area, popolazione=popolazione, densita=densita)
info_continents

Prevalenza DA VEDERE COME CALCOLARLA

Andiamo a calcolare la prevalenza del virus in % e di contagi per mille persone.

continent <- inner_join( info_continents, t_continent )
 
compute_prevalence_perc <- function(pop, cases){
  (cases/pop)*100
}

## prevalenza su 1_000_000 di abitanti 
compute_prevalence_abit <- function(pop, cases){
  (cases/pop)*1000000
}


t_continent <- subset(t_continent, Continent_Name!="North America" &  Continent_Name!="South America")
t_continent <- inner_join( t_continent, continent )

t_continent <- t_continent %>% 
  mutate( prev_perc = compute_prevalence_perc(popolazione, cases)) %>% 
  mutate( prev_abt = compute_prevalence_abit(popolazione, cases))

t_continent
ggplot( t_continent, aes( x = popolazione, y = prev_perc, color= Continent_Name) ) + 
  geom_point( size = 5) + 
  theme_minimal() + 
  xlab("popolazione") + 
  ylab("prevalenza %")

L’America pur avendo un numero di casi maggiore dell’Europa ha un indice di prevalenza minore, questo perchè la popolazione dell’Europa e pari a quasi \(3/4\) di quella Americana. L’Asia pur essendo stata la prima ad esser colpita, pare abbia tenuto bene sotto controllo l’epidemia, pur avendo una popolazione alta si sono riscontrati relativamente pochi casi e questo viene confermato dalla prevalenza su un milione di abitanti.

Andamento contagi per continente

group_continent <- continent_df %>% 
  group_by( date, Continent_Name ) %>% 
  summarise(
    cases = sum( cases ) 
  ) %>%
  ungroup()


p <- ggplot( group_continent, aes( x = date, y = cases, group = Continent_Name, color = Continent_Name)) + 
  geom_line( alpha = 0.3 ) + 
  theme_minimal()  +
  theme(legend.title = element_text("Continente") )

fig <- ggplotly(p) 
fig

Per visualizzare meglio il momento in cui i primi contagi sono avvenuti:

ggplot( group_continent, aes( x = date, y = cases, group = Continent_Name, color = Continent_Name)) + 
  geom_line( alpha = 2 ) +
  facet_wrap(~Continent_Name)+
  theme_minimal()

Si prova a costruire un modello per i contentinenti con casi più significativi: America e Europa

## [1] 0.9122166
## [1] 0.9122166

Pur avendo un indice di prevalenza minore rispetto l’America, i contagi in Europa sono cresciuti meno rapidamente e negli ultimi mesi si sono appiattiti.

VISUALIZZAZIONE DEI DATI

Visualizzazione dei contagi per regione. Con positivi si tiene conto di tutte le persone infettate fino a un dato momento.

ita_date <- data_ita_tidy %>% 
  group_by( data ) %>% 
  summarise(
    totPos = sum( totale_positivi ), 
    newPos = sum( nuovi_positivi )
  )


ggplot( data = ita_date ) +
  geom_line( mapping = aes( x = data, y = totPos), size = 0.5 ) +
  theme_minimal() + 
  theme( axis.text.x = element_text(angle = 60, hjust = 1 ))

L’andamento nuovi positivi giornalieri mostra l’andamento di contagi avvenuti. 

library(gifski)


plot <- ggplot(data_regIta_tidy, aes(nuovi_positivi, data, size = terapia_intensiva , colour = regione)) +
  geom_point(alpha = 0.7, show.legend = FALSE) +
  scale_size(range = c(2, 12)) +
  scale_x_log10() +
  facet_wrap(~regione) +
  # Here comes the gganimate specific bits
  labs(title = 'Data: {frame_time}', x = 'numero positivi giornalieri', y = 'data') +
  transition_time(data) +
  ease_aes('linear') +
  shadow_wake(0.15, wrap = FALSE)

## ad animate function for error ' The animation object does not specify a save_animation method ' 
animate(plot, duration = 5, fps = 12, width = 900, height = 600, renderer = gifski_renderer())

anim_save("itaRegione.gif")

# movimento verticale mostra il proggredire del tempo 
# quello orizzontale il numero di casi al giorno

Andiamo a visualizzare altri dati per risponde alle nostre ipotesi sulle morti e sui tamponi.